home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tclGlob.c < prev    next >
C/C++ Source or Header  |  1993-06-19  |  13KB  |  459 lines
  1. /* 
  2.  * tclGlob.c --
  3.  *
  4.  *    This file provides procedures and commands for file name
  5.  *    manipulation, such as tilde expansion and globbing.
  6.  *
  7.  * Copyright (c) 1990-1993 The Regents of the University of California.
  8.  * All rights reserved.
  9.  *
  10.  * Permission is hereby granted, without written agreement and without
  11.  * license or royalty fees, to use, copy, modify, and distribute this
  12.  * software and its documentation for any purpose, provided that the
  13.  * above copyright notice and the following two paragraphs appear in
  14.  * all copies of this software.
  15.  * 
  16.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20.  *
  21.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26.  */
  27.  
  28. #ifndef lint
  29. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGlob.c,v 1.33 93/06/19 17:35:06 ouster Exp $ SPRITE (Berkeley)";
  30. #endif /* not lint */
  31.  
  32. #include "tclInt.h"
  33. #include "tclUnix.h"
  34.  
  35. /*
  36.  * The structure below is used to keep track of a globbing result
  37.  * being built up (i.e. a partial list of file names).  The list
  38.  * grows dynamically to be as big as needed.
  39.  */
  40.  
  41. typedef struct {
  42.     char *result;        /* Pointer to result area. */
  43.     int totalSpace;        /* Total number of characters allocated
  44.                  * for result. */
  45.     int spaceUsed;        /* Number of characters currently in use
  46.                  * to hold the partial result (not including
  47.                  * the terminating NULL). */
  48.     int dynamic;        /* 0 means result is static space, 1 means
  49.                  * it's dynamic. */
  50. } GlobResult;
  51.  
  52. /*
  53.  * Declarations for procedures local to this file:
  54.  */
  55.  
  56. static int        DoGlob _ANSI_ARGS_((Tcl_Interp *interp, char *dir,
  57.                 char *rem));
  58.  
  59. /*
  60.  *----------------------------------------------------------------------
  61.  *
  62.  * DoGlob --
  63.  *
  64.  *    This recursive procedure forms the heart of the globbing
  65.  *    code.  It performs a depth-first traversal of the tree
  66.  *    given by the path name to be globbed.
  67.  *
  68.  * Results:
  69.  *    The return value is a standard Tcl result indicating whether
  70.  *    an error occurred in globbing.  After a normal return the
  71.  *    result in interp will be set to hold all of the file names
  72.  *    given by the dir and rem arguments.  After an error the
  73.  *    result in interp will hold an error message.
  74.  *
  75.  * Side effects:
  76.  *    None.
  77.  *
  78.  *----------------------------------------------------------------------
  79.  */
  80.  
  81. static int
  82. DoGlob(interp, dir, rem)
  83.     Tcl_Interp *interp;            /* Interpreter to use for error
  84.                      * reporting (e.g. unmatched brace). */
  85.     char *dir;                /* Name of a directory at which to
  86.                      * start glob expansion.  This name
  87.                      * is fixed: it doesn't contain any
  88.                      * globbing chars. */
  89.     char *rem;                /* Path to glob-expand. */
  90. {
  91.     /*
  92.      * When this procedure is entered, the name to be globbed may
  93.      * already have been partly expanded by ancestor invocations of
  94.      * DoGlob.  The part that's already been expanded is in "dir"
  95.      * (this may initially be empty), and the part still to expand
  96.      * is in "rem".  This procedure expands "rem" one level, making
  97.      * recursive calls to itself if there's still more stuff left
  98.      * in the remainder.
  99.      */
  100.  
  101.     Tcl_DString newName;        /* Holds new name consisting of
  102.                      * dir plus the first part of rem. */
  103.     register char *p;
  104.     register char c;
  105.     char *openBrace, *closeBrace, *name, *dirName;
  106.     int gotSpecial, baseLength;
  107.     int result = TCL_OK;
  108.     struct stat statBuf;
  109.  
  110.     /*
  111.      * Make sure that the directory part of the name really is a
  112.      * directory.  If the directory name is "", use the name "."
  113.      * instead, because some UNIX systems don't treat "" like "."
  114.      * automatically. Keep the "" for use in generating file names,
  115.      * otherwise "glob foo.c" would return "./foo.c".
  116.      */
  117.  
  118.     if (*dir == '\0') {
  119.     dirName = ".";
  120.     } else {
  121.     dirName = dir;
  122.     }
  123.     if ((stat(dirName, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
  124.     return TCL_OK;
  125.     }
  126.     Tcl_DStringInit(&newName);
  127.  
  128.     /*
  129.      * First, find the end of the next element in rem, checking
  130.      * along the way for special globbing characters.
  131.      */
  132.  
  133.     gotSpecial = 0;
  134.     openBrace = closeBrace = NULL;
  135.     for (p = rem; ; p++) {
  136.     c = *p;
  137.     if ((c == '\0') || (c == '/')) {
  138.         break;
  139.     }
  140.     if ((c == '{') && (openBrace == NULL)) {
  141.         openBrace = p;
  142.     }
  143.     if ((c == '}') && (openBrace != NULL) && (closeBrace == NULL)) {
  144.         closeBrace = p;
  145.     }
  146.     if ((c == '*') || (c == '[') || (c == '\\') || (c == '?')) {
  147.         gotSpecial = 1;
  148.     }
  149.     }
  150.  
  151.     /*
  152.      * If there is an open brace in the argument, then make a recursive
  153.      * call for each element between the braces.  In this case, the
  154.      * recursive call to DoGlob uses the same "dir" that we got.
  155.      * If there are several brace-pairs in a single name, we just handle
  156.      * one here, and the others will be handled in recursive calls.
  157.      */
  158.  
  159.     if (openBrace != NULL) {
  160.     char *element;
  161.  
  162.     if (closeBrace == NULL) {
  163.         Tcl_ResetResult(interp);
  164.         interp->result = "unmatched open-brace in file name";
  165.         result = TCL_ERROR;
  166.         goto done;
  167.     }
  168.     Tcl_DStringAppend(&newName, rem, openBrace-rem);
  169.     baseLength = newName.length;
  170.     p = openBrace;
  171.     for (p = openBrace; *p != '}'; ) {
  172.         element = p+1;
  173.         for (p = element; ((*p != '}') && (*p != ',')); p++) {
  174.         /* Empty loop body. */
  175.         }
  176.         Tcl_DStringAppend(&newName, element, p-element);
  177.         Tcl_DStringAppend(&newName, closeBrace+1, -1);
  178.         result = DoGlob(interp, dir, newName.string);
  179.         if (result != TCL_OK) {
  180.         goto done;
  181.         }
  182.         newName.length = baseLength;
  183.     }
  184.     goto done;
  185.     }
  186.  
  187.     /*
  188.      * Start building up the next-level name with dir plus a slash if
  189.      * needed to separate it from the next file name.
  190.      */
  191.  
  192.     Tcl_DStringAppend(&newName, dir, -1);
  193.     if ((dir[0] != 0) && (newName.string[newName.length-1] != '/')) {
  194.     Tcl_DStringAppend(&newName, "/", 1);
  195.     }
  196.     baseLength = newName.length;
  197.  
  198.     /*
  199.      * If there were any pattern-matching characters, then scan through
  200.      * the directory to find all the matching names.
  201.      */
  202.  
  203.     if (gotSpecial) {
  204.     DIR *d;
  205.     struct dirent *entryPtr;
  206.     char savedChar;
  207.  
  208.     d = opendir(dirName);
  209.     if (d == NULL) {
  210.         Tcl_ResetResult(interp);
  211.         Tcl_AppendResult(interp, "couldn't read directory \"",
  212.             dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  213.         result = TCL_ERROR;
  214.         goto done;
  215.     }
  216.  
  217.     /*
  218.      * Temporarily store a null into rem so that the pattern string
  219.      * is now null-terminated.
  220.      */
  221.  
  222.     savedChar = *p;
  223.     *p = 0;
  224.  
  225.     while (1) {
  226.         entryPtr = readdir(d);
  227.         if (entryPtr == NULL) {
  228.         break;
  229.         }
  230.  
  231.         /*
  232.          * Don't match names starting with "." unless the "." is
  233.          * present in the pattern.
  234.          */
  235.  
  236.         if ((*entryPtr->d_name == '.') && (*rem != '.')) {
  237.         continue;
  238.         }
  239.         if (Tcl_StringMatch(entryPtr->d_name, rem)) {
  240.         newName.length = baseLength;
  241.         Tcl_DStringAppend(&newName, entryPtr->d_name, -1);
  242.         if (savedChar == 0) {
  243.             if (access(newName.string, F_OK) == 0) {
  244.             Tcl_AppendElement(interp, newName.string);
  245.             }
  246.         } else {
  247.             result = DoGlob(interp, newName.string, p+1);
  248.             if (result != TCL_OK) {
  249.             break;
  250.             }
  251.         }
  252.         }
  253.     }
  254.     closedir(d);
  255.     *p = savedChar;
  256.     goto done;
  257.     }
  258.  
  259.     /*
  260.      * The current element is a simple one with no fancy features.  Add
  261.      * it to the new name.  If there are more elements still to come,
  262.      * then recurse to process them.
  263.      */
  264.  
  265.     Tcl_DStringAppend(&newName, rem, p-rem);
  266.     if (*p != 0) {
  267.     result = DoGlob(interp, newName.string, p+1);
  268.     goto done;
  269.     }
  270.  
  271.     /*
  272.      * There are no more elements in the pattern.  Check to be sure the
  273.      * file actually exists, then add its name to the list being formed
  274.      * in interp-result.
  275.      */
  276.  
  277.     name = newName.string;
  278.     if (*name == 0) {
  279.     name = ".";
  280.     }
  281.     if (access(name, F_OK) != 0) {
  282.     goto done;
  283.     }
  284.     Tcl_AppendElement(interp, name);
  285.  
  286.     done:
  287.     Tcl_DStringFree(&newName);
  288.     return result;
  289. }
  290.  
  291. /*
  292.  *----------------------------------------------------------------------
  293.  *
  294.  * Tcl_TildeSubst --
  295.  *
  296.  *    Given a name starting with a tilde, produce a name where
  297.  *    the tilde and following characters have been replaced by
  298.  *    the home directory location for the named user.
  299.  *
  300.  * Results:
  301.  *    The result is a pointer to a static string containing
  302.  *    the new name.  If there was an error in processing the
  303.  *    tilde, then an error message is left in interp->result
  304.  *    and the return value is NULL.  The result may be stored
  305.  *    in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
  306.  *    to free the name.
  307.  *
  308.  * Side effects:
  309.  *    Information may be left in bufferPtr.
  310.  *
  311.  *----------------------------------------------------------------------
  312.  */
  313.  
  314. char *
  315. Tcl_TildeSubst(interp, name, bufferPtr)
  316.     Tcl_Interp *interp;        /* Interpreter in which to store error
  317.                  * message (if necessary). */
  318.     char *name;            /* File name, which may begin with "~/"
  319.                  * (to indicate current user's home directory)
  320.                  * or "~<user>/" (to indicate any user's
  321.                  * home directory). */
  322.     Tcl_DString *bufferPtr;    /* May be used to hold result.  Must not hold
  323.                  * anything at the time of the call, and need
  324.                  * not even be initialized. */
  325. {
  326.     char *dir;
  327.     register char *p;
  328.  
  329.     Tcl_DStringInit(bufferPtr);
  330.     if (name[0] != '~') {
  331.     return name;
  332.     }
  333.  
  334.     if ((name[1] == '/') || (name[1] == '\0')) {
  335.     dir = getenv("HOME");
  336.     if (dir == NULL) {
  337.         Tcl_ResetResult(interp);
  338.         Tcl_AppendResult(interp, "couldn't find HOME environment ",
  339.             "variable to expand \"", name, "\"", (char *) NULL);
  340.         return NULL;
  341.     }
  342.     Tcl_DStringAppend(bufferPtr, dir, -1);
  343.     Tcl_DStringAppend(bufferPtr, name+1, -1);
  344.     } else {
  345.     struct passwd *pwPtr;
  346.  
  347.     for (p = &name[1]; (*p != 0) && (*p != '/'); p++) {
  348.         /* Null body;  just find end of name. */
  349.     }
  350.     Tcl_DStringAppend(bufferPtr, name+1, p - (name+1));
  351.     pwPtr = getpwnam(bufferPtr->string);
  352.     if (pwPtr == NULL) {
  353.         endpwent();
  354.         Tcl_ResetResult(interp);
  355.         Tcl_AppendResult(interp, "user \"", bufferPtr->string,
  356.             "\" doesn't exist", (char *) NULL);
  357.         return NULL;
  358.     }
  359.     Tcl_DStringFree(bufferPtr);
  360.     Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);
  361.     Tcl_DStringAppend(bufferPtr, p, -1);
  362.     endpwent();
  363.     }
  364.     return bufferPtr->string;
  365. }
  366.  
  367. /*
  368.  *----------------------------------------------------------------------
  369.  *
  370.  * Tcl_GlobCmd --
  371.  *
  372.  *    This procedure is invoked to process the "glob" Tcl command.
  373.  *    See the user documentation for details on what it does.
  374.  *
  375.  * Results:
  376.  *    A standard Tcl result.
  377.  *
  378.  * Side effects:
  379.  *    See the user documentation.
  380.  *
  381.  *----------------------------------------------------------------------
  382.  */
  383.  
  384.     /* ARGSUSED */
  385. int
  386. Tcl_GlobCmd(dummy, interp, argc, argv)
  387.     ClientData dummy;            /* Not used. */
  388.     Tcl_Interp *interp;            /* Current interpreter. */
  389.     int argc;                /* Number of arguments. */
  390.     char **argv;            /* Argument strings. */
  391. {
  392.     int i, result, noComplain, firstArg;
  393.  
  394.     if (argc < 2) {
  395.     notEnoughArgs:
  396.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  397.         " ?switches? name ?name ...?\"", (char *) NULL);
  398.     return TCL_ERROR;
  399.     }
  400.     noComplain = 0;
  401.     for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
  402.         firstArg++) {
  403.     if (strcmp(argv[firstArg], "-nocomplain") == 0) {
  404.         noComplain = 1;
  405.     } else if (strcmp(argv[firstArg], "--") == 0) {
  406.         firstArg++;
  407.         break;
  408.     } else {
  409.         Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
  410.             "\": must be -nocomplain or --", (char *) NULL);
  411.         return TCL_ERROR;
  412.     }
  413.     }
  414.     if (firstArg >= argc) {
  415.     goto notEnoughArgs;
  416.     }
  417.  
  418.     for (i = firstArg; i < argc; i++) {
  419.     char *thisName;
  420.     Tcl_DString buffer;
  421.  
  422.     thisName = Tcl_TildeSubst(interp, argv[i], &buffer);
  423.     if (thisName == NULL) {
  424.         return TCL_ERROR;
  425.     }
  426.     if (*thisName == '/') {
  427.         if (thisName[1] == '/') {
  428.         /*
  429.          * This is a special hack for systems like those from Apollo
  430.          * where there is a super-root at "//":  need to treat the
  431.          * double-slash as a single name.
  432.          */
  433.         result = DoGlob(interp, "//", thisName+2);
  434.         } else {
  435.         result = DoGlob(interp, "/", thisName+1);
  436.         }
  437.     } else {
  438.         result = DoGlob(interp, "", thisName);
  439.     }
  440.     Tcl_DStringFree(&buffer);
  441.     if (result != TCL_OK) {
  442.         return result;
  443.     }
  444.     }
  445.     if ((*interp->result == 0) && !noComplain) {
  446.     char *sep = "";
  447.  
  448.     Tcl_AppendResult(interp, "no files matched glob pattern",
  449.         (argc == 2) ? " \"" : "s \"", (char *) NULL);
  450.     for (i = firstArg; i < argc; i++) {
  451.         Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
  452.         sep = " ";
  453.     }
  454.     Tcl_AppendResult(interp, "\"", (char *) NULL);
  455.     return TCL_ERROR;
  456.     }
  457.     return TCL_OK;
  458. }
  459.